home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / xlib / yicons24 / source / sbfm.cpp < prev    next >
Text File  |  1992-11-18  |  4KB  |  154 lines
  1. eat
  2.     Color := RandColor;
  3.     SetColor(Color);
  4.     SetFillStyle(Random(CloseDotFill)+1, Color);
  5.     Bar3D(Random(MaxWidth), Random(MaxHeight),
  6.           Random(MaxWidth), Random(MaxHeight), 0, TopOff);
  7.   until KeyPressed;
  8.   WaitToGo;
  9. end; { RandBarPlay }
  10.  
  11. procedure ArcPlay;
  12. { Draw random arcs on the screen }
  13. var
  14.   MaxRadius : word;
  15.   EndAngle : word;
  16.   ArcInfo : ArcCoordsType;
  17. begin
  18.   MainWindow('Arc / GetArcCoords demonstration');
  19.   StatusLine('Esc aborts or press a key');
  20.   MaxRadius := MaxY div 10;
  21.   repeat
  22.     SetColor(RandColor);
  23.     EndAngle := Random(360);
  24.     SetLineStyle(SolidLn, 0, NormWidth);
  25.     Arc(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle, Random(MaxRadius));
  26.     GetArcCoords(ArcInfo);
  27.     with ArcInfo do
  28.     begin
  29.       Line(X, Y, XStart, YStart);
  30.       Line(X, Y, Xend, Yend);
  31.     end;
  32.   until KeyPressed;
  33.   WaitToGo;
  34. end; { ArcPlay }
  35.  
  36. procedure PutPixelPlay;
  37. { Demonstrate the PutPixel and GetPixel commands }
  38. const
  39.   Seed   = 1962; { A seed for the random number generator }
  40.   NumPts = 2000; { The number of pixels plotted }
  41.   Esc    = #27;
  42. var
  43.   I : word;
  44.   X, Y, Color : word;
  45.   XMax, YMax  : integer;
  46.   ViewInfo    : ViewPortType;
  47. begin
  48.   MainWindow('PutPixel / GetPixel demonstration');
  49.   StatusLine('Esc aborts or press a key...');
  50.  
  51.   GetViewSettings(ViewInfo);
  52.   with ViewInfo do
  53.   begin
  54.     XMax := (x2-x1-1);
  55.     YMax := (y2-y1-1);
  56.   end;
  57.  
  58.   while not KeyPressed do
  59.   begin
  60.     { Plot random pixels }
  61.     RandSeed := Seed;
  62.     I := 0;
  63.     while (not KeyPressed) and (I < NumPts) do
  64.     begin
  65.       Inc(I);
  66.         PutPixel(Random(XMax)+1, Random(YMax)+1, RandColor);
  67.     end;
  68.  
  69.     { Erase pixels }
  70.     RandSeed := Seed;
  71.     I := 0;
  72.     while (not KeyPressed) and (I < NumPts) do
  73.     begin
  74.       Inc(I);
  75.       X := Random(XMax)+1;
  76.       Y := Random(YMax)+1;
  77.       Color := GetPixel(X, Y);
  78.         if Color = RandColor then
  79.           PutPixel(X, Y, 0);
  80.      end;
  81.   end;
  82.   WaitToGo;
  83. end; { PutPixelPlay }
  84.  
  85. procedure PutImagePlay;
  86. { Demonstrate the GetImage and PutImage commands }
  87.  
  88. const
  89.   r  = 20;
  90.   StartX = 100;
  91.   StartY = 50;
  92.  
  93. var
  94.   CurPort : ViewPortType;
  95.  
  96. procedure MoveSaucer(var X, Y : integer; Width, Height : integer);
  97. var
  98.   Step : integer;
  99. begin
  100.   Step := Random(2*r);
  101.   if Odd(Step) then
  102.     Step := -Step;
  103.   X := X + Step;
  104.   Step := Random(r);
  105.   if Odd(Step) then
  106.     Step := -Step;
  107.   Y := Y + Step;
  108.  
  109.   { Make saucer bounce off viewport walls }
  110.   with CurPort do
  111.   begin
  112.     if (x1 + X + Width - 1 > x2) then
  113.       X := x2-x1 - Width + 1
  114.     else
  115.       if (X < 0) then
  116.         X := 0;
  117.     if (y1 + Y + Height - 1 > y2) then
  118.       Y := y2-y1 - Height + 1
  119.     else
  120.       if (Y < 0) then
  121.         Y := 0;
  122.   end;
  123. end; { MoveSaucer }
  124.  
  125. var
  126.   Pausetime : word;
  127.   Saucer    : pointer;
  128.   X, Y      : integer;
  129.   ulx, uly  : word;
  130.   lrx, lry  : word;
  131.   Size      : word;
  132.   I         : word;
  133. begin
  134.   ClearDevice;
  135.   FullPort;
  136.  
  137.   { PaintScreen }
  138.   ClearDevice;
  139.   MainWindow('GetImage / PutImage Demonstration');
  140.   StatusLine('Esc aborts or press a key...');
  141.   GetViewSettings(CurPort);
  142.  
  143.   { DrawSaucer }
  144.   Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2);
  145.   Ellipse(StartX, StartY-4, 190, 357, r, r div 3);
  146.   Line(StartX+7, StartY-6, StartX+10, StartY-12);
  147.   Circle(StartX+10, StartY-12, 2);
  148.   Line(StartX-7, StartY-6, StartX-10, StartY-12);
  149.   Circle(StartX-10, StartY-12, 2);
  150.   SetFillStyle(SolidFill, MaxColor);
  151.   FloodFill(StartX+1, StartY+4, GetColor);
  152.  
  153.   { ReadSaucerImage }
  154.   ulx := StartX-(